home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / db_dbug2.arc / LISTING.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-05  |  4.0 KB  |  124 lines
  1. type datetype= string[8];
  2.      regtype = record
  3.                  ax,bx,cx,dx,bp,si,di,ds,es,flags: integer
  4.                end;
  5.    fname      = string[66];
  6.  
  7. var ch, ch1                   : char;
  8.     st, pst, dst              : string[255];
  9.     name, outfile             : string[12];
  10.     rtd, gtd                  : string[66];
  11.     up_date                   : string[8];
  12.     i, atop, count, cnt_line  : integer;
  13.     a                         : array[1..400] of string[66];
  14.     filein, fileout           : text;
  15.     gonogo                    : boolean;
  16.  
  17. const blanks = '                                                                                             ';
  18.       nul = ^@;     seekattrib = $10;
  19.  
  20. function time: datetype;
  21. var reg:     regtype;
  22.     h,m,s,w: datetype;
  23.     i:       integer;
  24.  
  25. begin
  26.    reg.ax:=$2c00;
  27.    intr($21,reg);
  28.    str(hi(reg.cx):2,h);
  29.    str(lo(reg.cx):2,m);
  30.    str(hi(reg.dx):2,s);
  31.    w:=h+':'+m+':'+s;
  32.    for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
  33.    time:=w;
  34. end;
  35.  
  36. function date: datetype;
  37. var reg:     regtype;
  38.     y,m,d,w: datetype;
  39.     i:       integer;
  40.  
  41. begin
  42.    reg.ax:=$2a00;
  43.    intr($21,reg);
  44.    str(reg.cx:4,y);
  45.    delete(y,1,2);
  46.    str(hi(reg.dx):2,m);
  47.    str(lo(reg.dx):2,d);
  48.    w:=m+'/'+d+'/'+y;
  49.    for i:=1 to length(w) do if w[i]=' ' then w[i]:='0';
  50.    date:=w;
  51. end;
  52.  
  53. function exist(filename: fname): boolean;
  54. var xfile: text;
  55. begin
  56.    assign(xfile, filename);
  57.    {$I-}
  58.    reset(xfile);
  59.    {$I+}
  60.    exist:=(ioresult=0); {$I-} close(xfile); {I+}
  61. end;
  62.  
  63. procedure startup;
  64. begin
  65.    clrscr; gotoxy(16,5); writeln('Listing started ',time,' with ',atop:3,' files in queue.');
  66.    gotoxy(23,7); writeln('Press [SPACE BAR] to abort printing');
  67.    outfile:='prn'; assign(fileout,outfile); rewrite(fileout);
  68. end;
  69.  
  70. begin
  71.    st:=''; for i:=1 to paramcount do st:=st+paramstr(i); gonogo:=true;
  72.    atop:=0; for i:=1 to 400 do a[i]:=''; getdir(0,rtd);
  73.    if (length(st)>0) and exist(st) then begin
  74.       atop:=1; a[1]:=st;
  75.    end else
  76.    if (length(st)=0) and exist('listing.dat') then begin
  77.       close(fileout);
  78.       assign(filein,'listing.dat'); reset(filein);
  79.       while not eof(filein) do begin
  80.          readln(filein,gtd); atop:=atop+1; a[atop]:=gtd;
  81.       end;
  82.       close(filein);
  83.    end;
  84.    if atop>0 then begin
  85.       startup;
  86.       for i:=1 to atop do begin
  87.          if not exist(a[i]) then
  88.             writeln('ERROR --- ',a[i],' does not exist in this directory.  Skipping this file.')
  89.          else begin
  90.             gotoxy(23,12); write('Working on file #',i:3,' (',a[i],')');
  91.             assign(filein,a[i]); reset(filein); count:=1;
  92.             while (gonogo and (not eof(filein))) and (count<3) do begin
  93.                case count of
  94.                   1: dst:='File '+a[i]+'   in directory '+rtd;
  95.                   2: dst:='Run at '+time+' on '+date;
  96.                end;
  97.                readln(filein,st); count:=count+1;
  98.                writeln(fileout,st,copy(blanks,1,80-length(st)),dst);
  99.             end;
  100.             while gonogo and not eof(filein) do begin
  101.                ch:=chr(0); if keypressed then read(kbd,ch); if ch=' ' then begin
  102.                   writeln;
  103.                   write('Do you really wish to abort printing? '); read(ch);
  104.                   if ch in ['Y','y'] then gonogo:=false;
  105.                end else begin
  106.                   readln(filein,pst); writeln(fileout,pst);
  107.                end;
  108.             end;
  109.             if gonogo then writeln(fileout,chr(12));
  110.             close(filein);
  111.          end;
  112.       end;
  113.       close(fileout);
  114.    end else begin
  115.       if length(st)>0 then writeln(st,' does not exist.');
  116.       if not exist('listing.dat') then begin
  117.          writeln; writeln('The syntax for this program is LISTING [filename], where filename');
  118.          writeln('is optional.  If you do not add a filename, then LISTING looks for a file');
  119.          writeln('called LISTING.DAT in the current directory.  LISTING.DAT should have only the');
  120.          writeln('files you want printed, including extentions.');
  121.       end;
  122.    end;
  123. end.
  124.